home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / diskmags / 0022-3.564 / dmg-3418 / gfa_prog.s / unpakmed.lst < prev   
File List  |  1986-02-05  |  3KB  |  69 lines
  1. '                 ****************************************
  2. '                 *   Listing from DBA Diskmagazine 3    *
  3. '                 *                                      *
  4. '                 *   Med-res Degas picture loader       *
  5. '                 *        and un-packer in GFA          *
  6. '                 *  Converted from Hi-soft basic -> GFA *
  7. '                 *     Program by Bonus Software        *
  8. '                 *                                      *
  9. '                 ****************************************
  10. '
  11. sc%=XBIOS(3)                                    ! start address screen
  12. '
  13. DO
  14.   SHOWM                                         ! showm mouse
  15.   FILESELECT "a:\pictures\*.pc2","default.pc1",a$  ! fileselector to choose pic.
  16.   IF a$<>""                                     ! if exists
  17.     HIDEM                                       ! hide mouse
  18.     OPEN "i",#1,a$                              ! open picture
  19.     dummy$=INPUT$(2,#1)                         ! read first 2 usless (to us)
  20.     '                                           ! bytes.
  21.     FOR i%=0 TO 3                               ! for next to get the 4 colors
  22.       c%=256*ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))! make decimal value of it
  23.       SETCOLOR i%,c%                            ! setcolor to the value
  24.     NEXT i%                                     ! get next color
  25.     dummy$=INPUT$(24,#1)                        ! read rest of usless colors
  26.     scr%=sc%                                    ! copy screen address in scr%
  27.     FOR scan%=0 TO 199                          ! for next for number of lines
  28.       FOR plane%=0 TO 2 STEP 2                  ! for next for number of bit
  29.         '                                       ! planes ( med res 2 planes )
  30.         addr%=scr%+160*scan%+plane%             ! screen counter
  31.         volg%=addr%+160                         ! screen counter + 1 line
  32.         DO                                      ! start unpacking
  33.           b%=ASC(INPUT$(1,#1))
  34.           IF b%<128
  35.             FOR i%=0 TO b%
  36.               POKE addr%,ASC(INPUT$(1,#1))
  37.               IF addr% AND 1
  38.                 addr%=addr%+3
  39.               ELSE
  40.                 INC addr%
  41.               ENDIF
  42.             NEXT i%
  43.           ENDIF
  44.           IF b%>128
  45.             tel%=ASC(INPUT$(1,#1))
  46.             FOR i%=1 TO 256-b%+1
  47.               POKE addr%,tel%
  48.               IF addr% AND 1
  49.                 addr%=addr%+3
  50.               ELSE
  51.                 INC addr%
  52.               ENDIF
  53.             NEXT i%
  54.           ENDIF
  55.           EXIT IF addr%=volg%
  56.         LOOP
  57.       NEXT plane%
  58.     NEXT scan%
  59.     CLOSE #1
  60.     OUT 2,7
  61.     ~INP(2)
  62.     CLS
  63.     SETCOLOR 0,0
  64.     SETCOLOR 15,7,7,7
  65.   ELSE
  66.     END
  67.   ENDIF
  68. LOOP
  69.